home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / graphics.swg / 0165_Line & Circle routines.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-28  |  1.6 KB  |  66 lines
  1. {
  2. You asked for =F=A=S=T This line procedure is quite fast considering it
  3. is done in Pascal and not assembler.
  4. The Rectangle works well also.
  5. Sorry my Circle routine is rather Slow and Does not make a perfect (or
  6. fairly perfect) circle so I will not enclose it. <G>
  7.  
  8. Where is a word segment to a screen address.
  9. You can define the VGAScreen's address like this.
  10. Const  VGASCREEN = $a000;
  11. }
  12.  
  13. Procedure line(a,b,c,d,col:integer;Where:Word);
  14.   { This draws a line from a,b to c,d of color col. }
  15. Function sgn(a:real):integer;
  16.    BEGIN
  17.         if a>0 then sgn:=+1;
  18.         if a<0 then sgn:=-1;
  19.         if a=0 then sgn:=0;
  20.    END;
  21. var u,s,v,d1x,d1y,d2x,d2y,m,n:real;
  22.     i:integer;
  23. BEGIN
  24.      u:= c - a;
  25.      v:= d - b;
  26.      d1x:= SGN(u);
  27.      d1y:= SGN(v);
  28.      d2x:= SGN(u);
  29.      d2y:= 0;
  30.      m:= ABS(u);
  31.      n := ABS(v);
  32.      IF NOT (M>N) then
  33.      BEGIN
  34.           d2x := 0 ;
  35.           d2y := SGN(v);
  36.           m := ABS(v);
  37.           n := ABS(u);
  38.      END;
  39.      s := INT(m / 2);
  40.      FOR i := 0 TO round(m) DO
  41.      BEGIN
  42.           putpixel(a,b,col,where);
  43.           s := s + n;
  44.           IF not (s<m) THEN
  45.           BEGIN
  46.                s := s - m;
  47.                a:= a +round(d1x);
  48.                b := b + round(d1y);
  49.           END
  50.           ELSE
  51.           BEGIN
  52.                a := a + round(d2x);
  53.                b := b + round(d2y);
  54.           END;
  55.      END;
  56. END;
  57.  
  58. Procedure Rect(x1,y1,x2,y2,Color : integer;Where:word);
  59. begin
  60.      Line(x1,y1,x2,y1,color,Where);
  61.      Line(x1,y1,x1,y2,color,where);
  62.      Line(x2,y1,x2,y2,color,where);
  63.      Line(x1,y2,x2,y2,color,where);
  64.  
  65. end;
  66.